Loadstar 205/205.d81/grafstar demo

Commodore BASIC | 2001-01-01 | 7.6 KB | 279 lines

0 rem    grafstar.demo   by dave moorman
1 rem  make room for tools 9a00
2 poke55,0:poke56,154:clr
3 rem  <required for ls> set device
5 dv=peek(186):ifdv<8thendv=8
9 rem  hi is for grafstar c000.                poke disables irq before load
10 hi=192:pokehi*256+63,0
19 rem  memorize this bload routine!
20 sys57812"grafstar c000",dv,0:poke780,0:poke781,0:poke782,hi:sys65493
22 rem  grafstar sysies as names
23 op=hi*256 :rem    open
24 mode=op+3 :rem    mode
25 plot=op+6 :rem    plot
26 line=op+9 :rem    line
27 poin=op+12:rem    point
28 clip=op+15:rem    clip
29 ofst=op+18:rem    offset
30 yrev=op+21:rem    y-reverse
31 flip=op+24:rem    irq flipper
32 fill=op+27:rem    fill
33 penc=op+30:rem    pencolor
34 :
49 rem  bload tools 9a00
50 sys57812"tools 9a00",dv,0:poke780,0
51 poke781,0:poke782,154:sys65493
52 rem   tools 9a00 sysies as names
53 mu=154*256   :rem    menu
54 box=mu+3     :rem    box
55 shade=mu+39  :rem    shade
56 ss=mu+6      :rem    screen stash
57 sr=mu+9      :rem    screen restore
58 pa=mu+15     :rem    print at
59 ct=mu+18     :rem    print center
60 branch=mu+45 :rem    branch
61 :
98 ::::::::::::::::::::::::::::::::::
99 rem  demo screen and menu
100 print"[147]":poke53281,0:poke53280,0:poke53272,22:poke53265,11
110 sysbox,0,39,0,24,102,15
119 rem  windoze routine at 20000.              x=-1 means center box
120 x=-1:y=2:m=2:c=7:m$(1)="[215]elcome to"
130 m$(2)="[199] [210] [193] [198] [211] [212] [193] [210]   [196] [197] [205] [207]"
140 gosub20000
148 :
149 rem windoze routine at 20000.               x is real column
150 x=3:y=8:m=4:c=1
151 m$(1)="[213]se the menu to choose various
152 m$(2)[178]"effects.  (NULL)ist the program
153 m$(3)="for detailed remarks.  [200]ave
154 m$(4)[178]"asc(NULL)(NULL) with chr$raf(NULL)tar!  str$ (NULL)oorman
155 gosub20000
159 rem  windoze routine at 20000
160 x=12:y=16:m=6:c=14
161 m$(1)="[195]razy [195]ircles"
162 m$(2)="[205]oire [208]atterns"
163 m$(3)="[198]ast [198]ill"
164 m$(4)="[208]olygon [206]uts"
165 m$(5)="[204]ist [208]rogram"
166 m$(6)="[197]xit [199]raf[211]tar"
167 gosub20000:poke53265,27
169 rem  menu
170 sysmu,y+1,xx+2,xx+wd-1,6,14,1,0
180 onf%gosub1000,2000,3000,4000,5000,61000
190 goto100
998 :::::::::::::::::::::::::::::::::
999 rem      crazy circles
1000 sys op,224,204 :rem <must> set maps
1009 rem  switch on high-res with clear
1010 sys mode,5
1014 rem set clip to whole screen
1015 sys clip, 0, 320, 0, 200
1019 rem for 10 times:
1020 fory=1to10
1029 rem find random centers for circle
1030 cx=rnd(1)*320
1040 cy=rnd(1)*200
1049 rem find random x / y radii
1050 x1=rnd(1)*160
1060 y1=rnd(1)*100
1064 rem choose random color
1065 c=rnd(1)*15+1
1069 rem set offset to center circle
1070 sys ofst, cx, cy
1079 rem plot first point on circle
1080 sys plot, sin(0)*x1, cos(0)*y1, 1
1085 sys penc,0,c,0,0
1089 rem then draw lines around circle
1090 forx=.3 to (NULL)*2+.3 step .3
1100 sys line, sin(x)*x1, cos(x)*y1, 1
1110 next: next
1114 rem return offset to normal
1115 sys ofst, 0, 0
1116 sys fill, 160, 100, 1
1119 rem routine finished
1120 poke53280,12
1129 rem wait for keystroke
1130 poke198,0:wait198,1:poke198,0
1139 rem and go back to menu
1140 print"[147]":sys mode, 0
1150 return
1998 :::::::::::::::::::::::::::::::
1999 rem  moire pattern                      set bitmap/colormap location
2000 sys op, 224, 204
2009 rem switch to multi-color. clear
2010 sys mode, 7
2019 rem set up window clip limits
2020 x1=40:x2=110:y1=25:y2=125
2029 rem  set center for moray
2030 cx=90:cy=60
2039 rem draw object
2040 sys clip, x1, x2, y1, y2
2049 rem  set offset to center of moire
2050 sys ofst, cx, cy
2059 rem  choose pen colors
2060 sys penc, 0, 1, 7, 3
2064 rem and choose pen number
2065 p=0
2069 rem for 10 times
2070 fory=1to10
2074 rem increase and rollover pen #
2075 p=(p+1)and3
2079 rem going around the circle
2080 forx=0 to (NULL)*2 step .1
2089 rem plot the center
2090 sys plot, 0, 0, p
2099 rem and line to circumference
2100 sys line, sin(x)*100, cos(x)*100,p
2110 next
2119 rem move window and moire center
2120 x1=x1+3:x2=x2+3:y1=y1+2:y2=y2+2
2130 cx=cx-3: cy=cy+2
2139 rem change moire center
2140 sys ofst, cx, cy
2149 rem change window location
2150 sys clip, x1, x2, y1, y2
2160 next
2169 rem routine over
2170 poke53280,12
2180 poke198,0:wait198,1:poke198,0
2190 print"[147]":sys mode, 0
2200 return
2998 :::::::::::::::::::::::::::::::
2999 rem   fast fill routine                       set bitmap/colormap memory
3000 sys op, 224, 204
3009 rem switch to multi-color/ clear
3010 sys mode, 7
3019 rem set offset to normal
3020 sys ofst, 0, 0
3024 rem set pen colors
3025 sys penc, 0, 1, 2, 3
3029 rem set cliping to whole screen
3030 sys cl, 0, 160, 0, 200
3039 rem draw object
3040 :sys plot, 0, 0, 1
3050 :sys line, 159, 0, 1
3060 :sys line, 159, 199, 1
3070 :sys line, 0, 199, 1
3080 :sys line, 0, 0, 1
3090 :sys plot, 10, 10, 2
3100 :forx=10 to 140 step 20
3110 :sys line, x, 40, 2
3120 :sys line, x+10, 40, 2
3130 :sys line, x+10, 10, 2
3140 :sys line, x+20, 10, 2
3150 :next
3160 :sys line, x, 100, 2
3170 :sys line, 70, 150, 2
3180 :sys line, 50, 50, 2
3190 :sys line, 70, 45, 2
3200 :sys line, 50, 45, 2
3210 :sys line, 70, 50, 2
3220 :sys line, 40,90, 2
3230 :sys line, 10, 100, 2
3240 :sys line, 5, 10, 2
3250 :sys line, 10, 10, 2
3260 :sys fill, 100, 80, 3
3270 sys penc, 0, 7, 2, 3
3279 rem   fill middle area
3280 sys fill, 55, 55, 1
3289 rem   draw circle
3290 sys ofst, 30, 160
3300 sys plot, sin(0)*15, cos(0)*10, 3
3310 forx=.3 to (NULL)*2+.3step.3
3320 sys line, sin(x)*15, cos(x)*10, 3
3330 next
3339 rem   fill circle
3340 sys penc, 0, 7, 5, 5
3350 sys ofst, 0, 0
3360 sys fill, 30, 160, 2
3370 sys penc, 6, 7, 5, 3
3379 rem   fill outer area                 (i had to do some hedging here)
3380 forx=15to155step20:sys fill, x, 39, 1:next:sys fill, 1, 1, 1
3389 rem fill inner area with pen 0
3390 sys fill, 100, 80, 0
3399 rem end routine.                            flash until keypress
3400 poke53281,rnd(1)*16:getz$:ifz$=""then3400
3410 print"[147]":sys mode, 0
3420 return
3998 :::::::::::::::::::::::::::::::
3999 rem  polygon nuts
4000 sys op, 224, 204
4004 rem  flip lets you press shift/control/f1 to flip between screens
4005 sys flip,1
4009 rem switch to multi-color/ clear
4010 sys mode, 7
4019 rem set pen colors
4020 sys penc, 0, 1, 7, 10
4029 rem define edges of area                    and draw a box around it
4030 le=50:ri=110:tp=50:bt=150
4031 sys plot,49,49,1:sysline,111,49,1:sysline,111,151,1
4032 sysline,49,151,1:sysline,49,49,1
4033 rem  define deltas for each vertex
4034 dx(0)=-2:dy(0)=1
4035 dx(1)=1:dy(1)=-2
4036 dx(2)=-1:dy(2)=-1
4037 dx(3)=2:dy(3)=2
4039 rem set vertices at 100
4040 forx=0to3
4050 px(x,0)=100
4060 py(x,0)=100
4065 next
4099 rem sq is lag time.  q is current plot.  oq is last plot.  rq is erased
4100 sq=7:oq=q:q=(q+1)andsq:rq=(q-sq)andsq:forx=0to3
4109 rem  calculate new coordinates
4110 px(x,q)=px(x,oq)+dx(x)
4120 py(x,q)=py(x,oq)+dy(x)
4129 rem check if in area
4130 if(px(x,q)<le)thendx(x)=-dx(x):px(x,q)=le:goto4200
4135 ifpx(x,q)>rithendx(x)=-dx(x):px(x,q)=ri:goto4200
4140 ifpy(x,q)<tpthendy(x)=-dy(x):py(x,q)=tp:goto4200
4145 ifpy(x,q)>btthendy(x)=-dy(x):py(x,q)=bt:goto4200
4200 next
4209 rem plot and line vertices
4210 sys plot,px(0,q),py(0,q)  ,1
4220 sys line,px(1,q),py(1,q)  ,2
4230 sys line,px(2,q),py(2,q)  ,3
4240 sys line,px(3,q),py(3,q)  ,2
4250 sys line,px(0,q),py(0,q)  ,1
4260 sys plot,px(0,rq),py(0,rq),0
4270 sys line,px(1,rq),py(1,rq),0
4280 sys line,px(2,rq),py(2,rq),0
4290 sys line,px(3,rq),py(3,rq),0
4300 sys line,px(0,rq),py(0,rq),0
4309 rem if key not pressed, do again
4310 getz$:ifz$=""then4100
4320 print"[147]":sys mode, 0:sysflip,0
4330 return
4998 :::::::::::::::::::::::::::::::::
4999 rem     list program
5000 print"[147]":list
19998 :::::::::::::::::::::::::::::::::
19999 end:rem  20000- window drawer
20000 wd=0:fori=1tom:ifwd<len(m$(i))thenwd=len(m$(i))
20010 next:wd=wd+2:ifint(wd/2)<>wd/2thenwd=wd+1
20015 xx=x
20020 ifx<0thenxx=int(20-wd/2)
20030 sysshade,xx+1,xx+wd+1,y+1,y+m+1+1
20040 sysbox,xx,xx+wd,y,y+m+1,160,c
20050 poke646,c:print"";:fori=1tom
20060 ifx<0thensysct,y+i,m$(i):goto20070
20065 syspa,xx+2,y+i,m$(i)
20070 next:return
40000 fori=0to21:poke828+i,8+i:next
40010 ifdv<8ordv>29ordv=8then40030
40020 a=peek(828):b=peek(828+dv-8):poke828,b:poke828+dv-8,a
40030 a$="hello connect":forj=8to29:i=peek(828+j-8):ifi=14thennext
40040 close2:open2,i,2:close2:ifstthen40060
40050 close15:open15,i,15,"r0:"+a$+"="+a$:input#15,er:close15:ifer=63then40070
40060 next:print"[147]":poke53272,23:poke186,8:poke2048,0:poke44,8:poke43,1:end
40070 q$=chr$(34):poke646,peek(53281):print"[147]":poke53272,23
40080 print"[147]p[207]2048,0:p[207]44,8:p[207]43,1:p[207]56,160:p[207]55,0:clr:l[207]"q$a$q$","i
40090 print"run:":poke631,13:poke632,13:poke198,2:end
59999 end
60000 open15,8,15,"s0:grafstar demo":close15:save"0:grafstar demo",8
60999 end
61000 poke53280,0:poke53265,11:poke53281,0:print"[147]":poke53265,27
61001 poke56,160:poke55,0:clr:c$="[147]"+chr$(34):d$=chr$(34)+",":goto40000
61010 close15:open15,i,15,"r0:"+a$+"="+a$:input#15,er:close15:ifer=63then61030